home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbs_mpl.zip / MBS10705.MRG < prev    next >
Text File  |  1992-07-05  |  35KB  |  969 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against E:\RBBS\STOCK\RBBSSUB1.BAS to produce E:\RBBS\CHAT\RBBSSUB1.BAS
  3. * E:\RBBS\STOCK\RBBSSUB1.BAS:  Date 6-20-1992  Size 55569 bytes
  4. * ------------[ Created 07-05-1992 07:15:15 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBS-SUB1.BAS 17.4, Copyright 1986-92 by D. Thomas Mack'
  8. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB1.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986-1992
  13. '  Purpose.............:
  14. '     Subprorams that require error trapping are incorporated
  15. '     within RBBSSUB1.BAS as separately callable subroutines
  16. '     in order to free up as much code as possible within
  17. '     the 64WasK code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  ChangeDir   20101   Change subdirectory
  23. '  CheckInt    58360   Check input is valid integer
  24. '  CommPut     59275   Write string to communications port
  25. '  FindFile    59790   Determine whether a file exists without opening it
  26. '  FindFree    51098   Find amount of space on the upload disk drive
  27. '  FindItX     20219   Find if a file exists on a device
  28. '  FindUser    12598   Find a user in the USERS file
  29. '  FlushCom    20308   Read all characters in the communications port
  30. '  GetCom       1418   Read a character from the communications port
  31. '  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
  32. '  GETWRK      58330   Read record from file number 2
  33. '  KillWork    58258   Delete a RBBS-PC "WORK" file
  34. '  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
  35. '  OpenCom       200   Open communications port (number 3)
  36. '  OpenFMS     58188   Open the upload management system directory
  37. '  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
  38. '  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
  39. '  OpenUser     9398   Open the USER file (number 5)
  40. '  OpenWork    57978   Open RBBS-PC's work file (number 2)
  41. '  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  42. '  Printit     13673   Print line on the local PC printer
  43. '  PrintWork   58320   Print string to file #2 w/o CR/LF
  44. '  PrintWorkA  58350   Print string to file #2 with CR/LF
  45. '  PutCom      59650   Write to the communications port
  46. '  PutWork     59660   Write to work file randomly
  47. * ------[ first line different ]------
  48. '  RBBSPlay    59680   Plays a musical string          'Removed from Maple
  49. '  ReadAny     58310   Read file number 2 into ZOutTxt$
  50. '  ReadDef       112   Read configuration file
  51. '  ReadDir     58290   Read entire lines
  52. '  ReadParmsX  58300   Read certain number of parameters from specified file
  53. '  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired Removed
  54. '  SetCall       108   Find where next callers record is
  55. '  UpdateC     43048   Update the caller's file with elasped session time
  56. '  UpdtCalr    13661   Update to the caller's file
  57. '  ViewTxt     60139   Display ASCII file from Compressed file 'Pe 02/03/90
  58. '
  59. '  $INCLUDE: 'RBBS-VAR.BAS'
  60. * REPLACING old line(s) by new
  61. 117 IF ZSubParm <> -62 THEN _
  62.        IF PrevRead$ = ConfigFile$ THEN _
  63.           EXIT SUB _
  64.        ELSE PrevRead$ = ConfigFile$
  65.     CLOSE 2
  66.     ZBulletinSave$ = ZBulletinMenu$
  67.     CALL OpenWork (2,ConfigFile$)
  68.     ZCurDef$ = ConfigFile$
  69.     INPUT #2,ZWasDF$, _
  70.              ZDnldDrives$, _
  71.              ZSysopPswd1$, _
  72.              ZSysopPswd2$, _
  73.              ZSysopFirstName$, _
  74.              ZSysopLastName$, _
  75.              ZRequiredRings, _
  76.              ZStartOfficeHours, _
  77.              ZEndOfficeHours, _
  78.              ZMinsPerSession, _
  79.              ZWasDF, _
  80.              ZWasDF, _
  81.              ZUpldDir$, _
  82.              ZExpertUserDef, _
  83.              ZActiveBulletins, _
  84.              ZPromptBellDef, _
  85.              ZWasDF, _
  86.              ZMenusCanPause, _
  87.              ZMenu$(1), _
  88.              ZMenu$(2), _
  89.              ZMenu$(3), _
  90.              ZMenu$(4), _
  91.              ZMenu$(5), _
  92.              ZMenu$(6), _
  93.              ZConfMenu$, _
  94.              ZTestANSITime, _
  95.              ZWelcomeInterruptable, _
  96.              ZRemindFileXfers, _
  97.              ZPageLengthDef, _
  98.              ZMaxMsgLinesDef, _
  99.              ZDoorsAvail, _
  100.              ZWasDF$, _
  101.              ZMainMsgFile$, _
  102.              ZMainMsgBackup$
  103.     INPUT #2, WasX$, _
  104.               ZCmntsFile$, _
  105.               ZMainUserFile$, _
  106.               ZWelcomeFile$, _
  107.               ZNewUserFile$, _
  108.               ZMainDirExtension$
  109.     CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
  110.     IF ZWasDF$ <> "" THEN _
  111.        ZCallersFile$ = WasX$
  112.     INPUT #2, ZWasDF$
  113.     IF ZComPort$ <> "COM0" THEN _
  114.        IF NOT ZConfMode THEN _
  115.           ZComPort$ = ZWasDF$
  116.     INPUT #2, ZBulletinsOptional, _
  117.               ZModemInitCmd$, _
  118.               ZRTS$, _
  119.               ZCallersLst$, _
  120.               ZFG, _
  121.               ZBG, _
  122.               ZBorder
  123.     IF ZConfMode THEN _
  124.        INPUT #2, ZWasDF$, _
  125.                  ZWasDF$ _
  126.     ELSE INPUT #2, ZRBBSBat$ , _
  127.                    ZRCTTYBat$
  128.     INPUT #2,ZOmitMainDir$, _
  129.              ZFirstNamePrompt$, _
  130.              ZHelp$(3), _
  131.              ZHelp$(4), _
  132.              ZHelp$(7), _
  133.              ZHelp$(9), _
  134.              ZBulletinMenu$, _
  135.              ZBulletinPrefix$, _
  136.              ZWasDF$, _
  137.              ZMsgReminder, _
  138.              ZRequireNonASCII, _
  139.              ZAskExtendedDesc, _
  140.              ZMaxNodes, _
  141.              ZNetworkType
  142.     IF ZConfMode THEN _
  143.          INPUT #2, ZwasDF _
  144.     ELSE INPUT #2, ZRecycleToDos
  145.     INPUT #2,ZWasDF, _
  146.              ZWasDF, _
  147.              ZTrashcanFile$
  148.     INPUT #2,ZMinLogonSec, _
  149.              ZDefaultSecLevel, _
  150.              ZSysopSecLevel, _
  151.              ZFileSecFile$, _
  152.              ZSysopMenuSecLevel, _
  153.              ZConfMailList$, _
  154.              ZMaxViolations, _
  155.              ZOptSec(50), _   ' SECURITY FOR SYSOP COMMANDS 1
  156.              ZOptSec(51), _
  157.              ZOptSec(52), _
  158.              ZOptSec(53), _
  159.              ZOptSec(54), _
  160.              ZOptSec(55), _
  161.              ZOptSec(56), _   ' SYSOP 7
  162.              ZPswdFile$, _
  163.              ZMaxPswdChanges, _
  164.              ZMinSecForTempPswd, _
  165.              ZOverWriteSecLevel, _
  166.              ZDoorsTermType, _
  167.              ZMaxPerDay
  168.     INPUT #2,ZOptSec(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  169.              ZOptSec(2), _
  170.              ZOptSec(3), _
  171.              ZOptSec(4), _
  172.              ZOptSec(5), _
  173.              ZOptSec(6), _
  174.              ZOptSec(7), _
  175.              ZOptSec(8), _
  176.              ZOptSec(9), _
  177.              ZOptSec(10), _
  178.              ZOptSec(11), _
  179.              ZOptSec(12), _
  180.              ZOptSec(13), _
  181.              ZOptSec(14), _
  182.              ZOptSec(15), _
  183.              ZOptSec(16), _
  184.              ZOptSec(17), _
  185.              ZOptSec(18), _   ' MAIN COMMAND 18
  186.              ZMinNewCallerBaud, _
  187.              ZWaitBeforeDisconnect
  188.     INPUT #2,ZOptSec(19), _      ' Security for FILE COMMANDS 1
  189.              ZOptSec(20), _
  190.              ZOptSec(21), _
  191.              ZOptSec(22), _
  192.              ZOptSec(23), _
  193.              ZOptSec(24), _
  194.              ZOptSec(25), _
  195.              ZOptSec(26), _      ' FILE COMMAND 8
  196.              ZOptSec(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  197.              ZOptSec(28), _
  198.              ZOptSec(29), _
  199.              ZOptSec(30), _
  200.              ZOptSec(31), _
  201.              ZOptSec(32), _
  202.              ZOptSec(33), _
  203.              ZOptSec(34), _
  204.              ZOptSec(35), _
  205.              ZOptSec(36), _
  206.              ZOptSec(37), _
  207.              ZOptSec(38), _   ' UTIL COMMAND 12
  208.              ZOptSec(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  209.              ZOptSec(47), _
  210.              ZOptSec(48), _
  211.              ZOptSec(49), _
  212.              ZUpldTimeFactor!, _
  213.              ZComputerType, _
  214.              ZRemindProfile, _
  215.              ZRBBSName$, _
  216.              ZCmdsBetweenRings, _
  217.              ZCopyrightSecs, _
  218.              ZPagingPtrSupport$
  219.     IF ZConfMode THEN _
  220. * ------[ first line different ]------
  221.          INPUT #2, ZwasDF$ _                    'Pe 04/14/92
  222.     ELSE INPUT #2, ZModemInitBaud$
  223.              IF ZErrCode > 0 THEN _
  224.                 EXIT SUB
  225. * REPLACING old line(s) by new
  226. 119 INPUT #2, ZPersonalDrvPath$, _
  227.               ZPersonalDir$, _
  228.               ZPersonalBegin, _
  229.               ZPersonalLen, _
  230.               ZPersonalProtocol$, _
  231.               ZPersonalConcat , _
  232.               ZPrivateReadSec, _
  233.               ZPublicReadSec, _
  234.               ZSecChangeMsg
  235.     IF ZConfMode THEN _
  236.          INPUT #2, ZwasDF _
  237.     ELSE INPUT #2, ZKeepInitBaud
  238.     INPUT #2, ZMainPUI$
  239.     IF ZConfMode THEN _
  240.        INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
  241.     ELSE INPUT #2, ZDefaultEchoer$, _
  242.                    ZHostEchoOn$, _
  243.                    ZHostEchoOff$
  244.     INPUT #2, ZSwitchBack, _
  245.               ZDefaultLineACK$, _
  246.               ZAltdirExtension$, _
  247.               ZDirPrefix$
  248.     IF ZConfMode THEN _
  249.        INPUT #2, ZWasDF, _
  250.                  ZWasDF, _
  251.                  ZWasDF _
  252.     ELSE INPUT #2, ZWasDF,_
  253.                    ZModemInitWaitTime, _
  254.                    ZModemCmdDelayTime
  255.     INPUT #2, ZTurboRBBS, _
  256.               ZSubDirCount, _
  257.               ZWasDF, _
  258.               ZUpldToSubdir, _
  259.               ZWasDF, _
  260.               ZUpldSubdir$, _
  261.               ZMinOldCallerBaud, _
  262.               ZMaxWorkVar, _
  263.               ZDiskFullGoOffline, _
  264.               ZExtendedLogging
  265.      IF ZConfMode THEN _
  266.         INPUT #2, ZWasDF$, _
  267.                   ZWasDF$, _
  268.                   ZWasDF$, _
  269.                   ZWasDF$ _
  270.      ELSE INPUT #2, ZModemResetCmd$, _
  271.                     ZModemCountRingsCmd$, _
  272.                     ZModemAnswerCmd$, _
  273.                     ZModemGoOffHookCmd$
  274.      INPUT #2,ZDiskForDos$, _
  275.               ZDumbModem, _
  276.               ZCmntsAsMsgs
  277.      IF ZConfMode THEN _
  278.         INPUT #2, ZWasDF, _
  279.                   ZWasDF, _
  280.                   ZWasDF, _
  281.                   ZWasDF, _
  282.                   ZWasDF, _
  283.                   ZWasDF _
  284.      ELSE INPUT #2, ZLSB,_
  285.                     ZMSB,_
  286.                     ZLineCntlReg,_
  287.                     ZModemCntlReg,_
  288.                     ZLineStatusReg,_
  289.                     ZModemStatusReg
  290.      INPUT #2,ZKeepTimeCredits, _
  291.               ZXOnXOff, _
  292.               ZAllowCallerTurbo, _
  293.               ZUseDeviceDriver$, _
  294.               ZPreLog$, _
  295.               ZNewUserQuestionnaire$, _
  296.               ZEpilog$, _
  297.               ZRegProgram$, _
  298.               ZQuesPath$, _
  299.               ZUserLocation$, _
  300.               ZWasDF$, _
  301.               ZWasDF$, _
  302.               ZWasDF$, _
  303.               ZEnforceRatios, _
  304.               ZSizeOfStack, _
  305.               ZSecExemptFromEpilog, _
  306.               ZUseBASICWrites, _
  307.               ZDosANSI, _
  308.               ZEscapeInsecure, _
  309.               ZUseDirOrder, _
  310.               ZAddDirSecurity, _
  311.               ZMaxExtendedLines, _
  312.               ZOrigCommands$
  313.      INPUT #2,ZLogonMailLevel$, _
  314.               ZMacroDrvPath$, _
  315.               ZMacroExtension$, _
  316.               ZEmphasizeOnDef$, _
  317.               ZEmphasizeOffDef$, _
  318.               ZFG1Def$, _
  319.               ZFG2Def$, _
  320.               ZFG3Def$, _
  321.               ZFG4Def$, _
  322.               ZSecVioHelp$
  323.      IF ZConfMode THEN _
  324.         INPUT #2,ZWasDF _
  325.      ELSE INPUT #2,ZFossil
  326.      INPUT #2,ZMaxCarrierWait, _
  327.               ZWasDF, _
  328.               ZSmartTextCode, _
  329.               ZTimeLock, _
  330.               ZWriteBufDef, _
  331.               ZSecKillAny, _
  332.               ZDoorsDef$, _
  333.               ZScreenOutMsg$, _
  334.               ZAutoPageDef$
  335.      IF ZErrCode > 0 THEN _
  336.         EXIT SUB
  337.      ZConfigFileName$ = ConfigFile$
  338.      CALL EditDef
  339. * ------[ first line different ]------
  340. * INSERTING new line(s)
  341. 150 MKDIR ZlibWorkDiskPath$ + ZNodeId$
  342.   IF ZErrCode = 75 THEN _
  343.      ZErrCode = 0
  344.     ZArkViewPath$ =  ZLibWorkDiskPath$ + ZNodeID$ + "\"   'Pe 08/15/91
  345.     ZChatFileName$ = ZLibDrive$+"RBBSCHAT.DEF"            'Pe 02/22/92
  346.      END SUB
  347. * REPLACING old line(s) by new
  348. 13674 IF ZPrinter THEN _
  349.          LPRINT Strng$
  350.       END SUB
  351. * ------[ first line different ]------
  352. '
  353. * DELETING old line(s)
  354. 20101
  355. 20103
  356. * REPLACING old line(s) by new
  357. 58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
  358. ' $PAGE
  359. '
  360. '  NAME    -- OpenFMS
  361. '
  362. '  INPUTS  -- PARAMETER                      MEANING
  363. '             ZShareIt                DOS SHARING FLAG
  364. '             ZFMSDirectory$          NAME OF FMS DIRECTORY
  365. '
  366. '  OUTPUTS -- LastRec                NUMBER OF THE Last
  367. '                                    RECORD IN THE FILE
  368. '             CatLen                 Length of the category code
  369. '
  370. '  PURPOSE -- To open the upload directory as a random file and find
  371. '             the number of the last record in the file.
  372. '
  373.       SUB OpenFMS (LastRec,CatLen) STATIC
  374.       ON ERROR GOTO 65000
  375.       CLOSE 2
  376. * ------[ first line different ]------
  377.  IF ZActiveFMSDir$  = "" THEN _   'Pe Lib Mod
  378. ZActiveFMSDir$ = ZFMSDirectory$  'Pe Lib mod
  379.       OldFile = (ZActiveFMSDir$ = PrevFMS$)
  380.       IF OldFile THEN _
  381.          GOTO 58192
  382.       CALL OpenWork (2,ZActiveFMSDir$)
  383.       CALL ReadDir (2,1)
  384.       IF ZErrCode > 0 THEN _
  385.          IF ZActiveFMSDir$ = ZPersonalDir$ THEN _
  386.             ZFMSFileLength = 36 + ZMaxDescLen + ZPersonalLen _
  387.          ELSE ZFMSFileLength = 38 + ZMaxDescLen _
  388.       ELSE ZFMSFileLength = LEN(ZOutTxt$) + 2
  389.       CalcCatLen = ZFMSFileLength - 35 - ZMaxDescLen + (ZFMSFileLength > 85)
  390.       CLOSE 2
  391. * REPLACING old line(s) by new
  392. 58192 ZErrCode = 0
  393.       IF ZShareIt THEN _
  394.          OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=ZFMSFileLength _
  395.       ELSE OPEN "R",2,ZActiveFMSDir$,ZFMSFileLength
  396. * ------[ first line different ]------
  397. If ZErrCode > 0 Then                    'Pe 02/02/90
  398.    ZerrCode = 0
  399. CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
  400.                      ZActiveFMSDir$)    'Pe 09/25/91
  401. Call QuickTPut1 (CHR$(7) +  "Error Has Occured...try again ! ")
  402.    LastRec = 0
  403.    EXIT SUB
  404. END IF                                   'Pe 02/02/90
  405.       LastRec = LOF(2)/ZFMSFileLength
  406.       CatLen = CalcCatLen
  407.       IF OldFile THEN _
  408.          EXIT SUB
  409.       PrevFMS$ = ZActiveFMSDir$
  410.       FIELD 2, ZFMSFileLength AS FMSRec$
  411.       GET #2,1
  412.       ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
  413.       ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
  414.       ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
  415.       ZWasDF = INSTR(FMSRec$,"CH(")
  416.       ZChainedDir$ = ""
  417.       IF ZWasDF > 0 AND (NOT ZWasA) THEN _
  418.          WasX = INSTR(ZWasDF,FMSRec$,")") : _
  419.          IF WasX > 0 THEN _
  420.             ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
  421.             CALL FindFile (ZChainedDir$,ZOK) : _
  422.             IF NOT ZOK THEN _
  423.                ZChainedDir$ = ""
  424.       IF ZActiveFMSDir$ = ZPersonalDir$ THEN _
  425.          ZFileWaiting = ZFalse
  426.       ZPersonalDnld = ((ZActiveFMSDir$ = ZPersonalDir$) OR _
  427.                        (INSTR(FMSRec$," PERS") > 0 AND NOT ZWasA))
  428.       ZFreeDnld = ZPersonalDnld
  429.       IF NOT ZWasA THEN _
  430.          IF INSTR(FMSRec$," NOFREE") > 0 THEN _
  431.             ZFreeDnld = ZFalse _
  432.          ELSE IF INSTR(FMSRec$," FREE") > 0 THEN _
  433.             ZFreeDnld = ZTrue
  434.       ZListOnly = ZPersonalDnld
  435.       IF NOT ZWasA THEN _
  436.          IF INSTR(FMSRec$," LISTONLY ") > 0 THEN _
  437.             ZListOnly = ZTrue
  438.       ZExtraDnldTime = -60 * ZPersonalDnld
  439.       IF NOT ZWasA THEN _
  440.          WasX = INSTR(FMSRec$," TIMEEXTRA ")
  441.          IF WasX > 0 THEN _
  442.             CALL CheckInt (MID$(FMSRec$,WasX+10)) : _
  443.             ZExtraDnldTime = ZTestedIntValue
  444.       END SUB
  445. * REPLACING old line(s) by new
  446. 59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
  447. ' $PAGE
  448. '
  449. '  NAME    --  PutCom
  450. '
  451. '  INPUTS  --   PARAMETER     MEANING
  452. '                STRNG$      STRING TO PRINT TO COMM PORT
  453. '              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
  454. '                            CONTROL BETWEEN THE PC AND THE MODEM
  455. '
  456. '  OUTPUTS --
  457. '
  458. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  459. '             before writing to the communications port.
  460. '
  461.       SUB PutCom (Strng$) STATIC
  462.       ON ERROR GOTO 65000
  463.       IF ZLocalUser THEN _
  464.          EXIT SUB
  465.       CALL CheckCarrier
  466.       IF ZSubParm = -1 THEN _
  467.          EXIT SUB
  468.       IF NOT ZXOffEd THEN _
  469.          GOTO 59652
  470.       ZSubParm = 1
  471.       CALL Line25
  472.       ZWasY$ = ZXOff$
  473. * ------[ first line different ]------
  474.       XOffTimeout! = TIMER + ZWaitBeforeDisconnect
  475.       WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
  476.          Char = -1
  477.          WHILE Char = -1 AND ZSubParm <> -1
  478.             GOSUB 59654
  479.          WEND
  480.          IF Char <> -1 THEN _
  481.             CALL GetCom(ZWasY$) : _
  482.             IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
  483.                ZWasY$ = ZXOff$
  484.       WEND
  485.       ZXOffEd = ZFalse
  486.       ZSubParm = 1
  487.       CALL Line25
  488. * REPLACING old line(s) by new
  489. 59654 CALL EofComm (Char)
  490.       CALL GoIdle
  491.       CALL CheckCarrier
  492. * ------[ first line different ]------
  493.       CALL CheckTime(XOffTimeout!, TempElapsed!,1)
  494.       IF ZSubParm = 2 THEN _
  495.          ZSubParm = -1
  496.       RETURN
  497.       END SUB
  498. * REPLACING old line(s) by new
  499. 59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
  500. ' $PAGE
  501. '
  502. '  NAME    -- PutWork
  503. '
  504. '  INPUTS  --   PARAMETER     MEANING
  505. '                STNG$       STRING TO WRITE TO FILE
  506. '                RecNum      RECORD NUMBER TO WRITE
  507. '                RecLen      LENGTH OF RECORD TO WRITE
  508. '
  509. '  OUTPUTS --
  510. '
  511. '  PURPOSE -- Writes uploaded file records to work file
  512. '
  513.       SUB PutWork (Strng$,RecNum,RecLen) STATIC
  514.       ON ERROR GOTO 65000
  515.       FIELD #2,RecLen AS ZUpldRec$
  516.       LSET ZUpldRec$ = Strng$
  517.       RecNum = RecNum + 1
  518.       PUT #2,RecNum
  519.       END SUB
  520. * ------[ first line different ]------
  521.  
  522. * DELETING old line(s)
  523. 59680
  524. 59700
  525. 59720
  526. 59721
  527. 59722
  528. 59723
  529. * REPLACING old line(s) by new
  530. 59791 IF FExists THEN _
  531.          IOErrorCount = 0 : _
  532.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
  533.          FExists = (WasZ = 0)
  534.       END SUB
  535. * ------[ first line different ]------
  536. '
  537. '* INSERTING new line(s)
  538. * INSERTING new line(s)
  539. 59800 SUB OpenWrk9 (ZChatFileName$) STATIC                            ' CHAT0805
  540.       ON ERROR GOTO 65000                                            ' CHAT0805
  541.       IF ZShareIt THEN                                               ' CHAT0805
  542.          OPEN ZChatFileName$ FOR RANDOM ACCESS READ WRITE SHARED AS #9 LEN = 128
  543.        ELSE                                                          ' CHAT0805
  544.          OPEN ZChatFileName$ FOR RANDOM AS #9 LEN = 128               ' CHAT0805
  545.       END IF                                                         ' CHAT0805
  546.       END SUB                                                        ' CHAT0805
  547.                                                                      ' CHAT0805
  548. 59810 SUB LockIt9 (Record, ReadIt) STATIC                            ' CHAT0805
  549.       ON ERROR GOTO 65000                                            ' CHAT0805
  550.       IF ZNetworkType=4 THEN                                         ' CHAT0901
  551.          CALL DVLock("CHAT")                                         ' CHAT0901
  552.       END IF                                                         ' CHAT0901
  553.       IF ZNetworkType <> 4 THEN LOCK 9, Record                       ' CHAT0901
  554.       IF ReadIt THEN                                                 ' CHAT0805
  555.          GET 9, Record                                               ' CHAT0805
  556.        ELSE                                                          ' CHAT0805
  557.          PUT 9, Record                                               ' CHAT0805
  558.       END IF                                                         ' CHAT0805
  559.       IF ZNetworkType=4 THEN                                         ' CHAT0901
  560.          CALL DVUnlock("CHAT")                                       ' CHAT0901
  561.       END IF                                                         ' CHAT0901
  562.       IF ZNetworkType <> 4 THEN UNLOCK 9, Record                     ' CHAT0901
  563.       END SUB                                                        ' CHAT0805
  564. '
  565. '
  566. 60139' $SUBTITLE: 'ViewTxt - Subroutine to display ASCII file from ARC file'
  567. ' $PAGE
  568. '
  569. '
  570. '  PURPOSE --  Allows user to access the contants of a Compressed file
  571. '              and either type an ASCII file to the screen or Xtract 
  572. '              selected members of archive. 
  573. '              To Enable this feature a .BAT file begining with X 
  574. '              and the name of the Archive type must be present were
  575. '              RBBS looks for command.com (e.g. XZIP.BAT for Zip Files)
  576. '              Three parameters are replaced in the Bat file
  577. '              [1] = FileName of selected archive
  578. '              [2] = Name of file to Xtract from archive
  579. '              [3] = Drive path specified in config for View work drive
  580. '                    to place xtracted file(s) in
  581. '
  582. '             example bat file  PKUNZIP -O [1] [2] [3]
  583. ' RBBS would insert  PKUNZIP - O  c:\new\arcfile.zip test.doc c:\view
  584. '
  585. '     The Re (Deafultextension).BAT file must contain the commands
  586. '      for the archiver you use only 2 parameters are passed to the file 
  587. '    %1) Drive\Path\ specified in config for V)iewarc feature
  588. '    %2) Default extension of compressed files on your BBS without the .
  589. '    %3) Added to Specify Node Number file is for      'LK 08/15/91
  590. '
  591. '     e.g.  PKZIP -m -ex %1VIEW%3.%2 %1*.*
  592. ' RBBS would insert PKZIP -m -ex C:\VIEW\VIEWx.ZIP C:\VIEW\*.*
  593. '
  594. '
  595.   SUB Viewtxt STATIC
  596.   ON ERROR GOTO 65000
  597. '
  598. 60140 ZSubParm = 1 
  599. ZOutTxt$ = ZCrLf$ +"T)ype, X)tract, C)ompress, L)ist dir, D)nld, K)ill ,H)elp or [Enter] Quits"   'PE 03/21/92
  600.            ZTurboKey = -ZTurboKeyUser
  601.            CALL TGet 
  602.      IF ZSubParm = -1 or ZWasQ = 0 THEN _
  603.                          EXIT SUB
  604.         CALL AllCaps (ZUserIn$)
  605.        MplX = INSTR("TXCLDK?HQ",ZUserIn$)   'pe 03/21/92
  606.      ON MplX GOTO 60149,60168,  60175,  60142,60183,60200,60141,60141,60280
  607. '                 Type  Xtract Compress  List  Dnld  Kill  Help  Help  Quit
  608. GOTO 60280
  609. '
  610. 60141 CALL BufFile (ZHelpPath$ + "ZIP" + ZHelpExtension$,WasX)
  611.       GOTO 60140 
  612. 60142  CALL QuickTPut1 ("Creating file list, one moment please...") 'Pe 10/03/91
  613.    EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST" 
  614.    call ShellExit (EXTRACT$)    'Pe 10/03/91
  615. CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX)
  616. GOTO 60140
  617. '
  618. 60149 ZSubParm = 1
  619.      ZOutTxt$ = "What file(s) to Type, R)elist or [ENTER] to quit" 
  620.      CALL TGet
  621. IF ZSubParm = -1 THEN _
  622.  EXIT SUB
  623.       ZWasB = 1
  624.        IF ZWasQ = 0 THEN _
  625.         GOTO 60140
  626. IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
  627.    CALL BufFile (ZArcWork$,WasX) : _
  628. GOTO 60149
  629.        LastArc = ZWasQ
  630.        FirstArc =ZWasB
  631. FOR ArcIndex = FirstArc TO LastArc
  632. WasZ$ = ZUserIn$(ArcIndex)
  633.    CALL AllCaps (WasZ$)  
  634.   IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
  635.     CALL QuickTPut1 ("Sorry Widcars NOT allowed !") : _   'Pe 10/03/91
  636.      GOTO 60149
  637.  CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)
  638. IF EXT$ = "" THEN _                                    'Pe 08/14/91
  639.    GOTO 60150                                          'Pe 08/14/91
  640.  IF INSTR("ZIP,ARC,LZH,ZOO,PAK,ARJ,DWC,BIN,LIB,OBJ,COM,EXE,PIC,GIF,",Ext$+",") > 0 THEN _  'Pe 08/04/91
  641.      CALL QuickTPut1 ("Sorry, only ASCII files can be Typed") :_  'Pe 10/03/91
  642.          GOTO 60149
  643. 60150  Gosub 60190         'Pe 10/03/91
  644.          CALL FindIt (WasZ$)
  645.       IF NOT ZOK THEN _
  646.   CALL QuickTPut1 (CHR$(7)+WasZ$+" NOT found or bad Spelling") :_  'Pe 10/03/91
  647.         GOTO 60149
  648.      CALL BufFile (WasZ$,WasX)
  649.       CALL KillWork(WasZ$)   'get rid of the files that were xtracted
  650.        NEXT ArcIndex
  651. GOTO 60140
  652. '
  653. 60168 ZSubParm = 1
  654.        ZOutTxt$ = ZCrLF$ +"What file(s) to Extract, R)elist or [ENTER] quits"
  655.           CALL TGet
  656.        IF ZSubParm = -1 THEN _
  657.              EXIT SUB
  658.      If ZWasQ = 0 THEN _    'Pe 10/20/91
  659.           GOTO 60140
  660.        IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
  661.           CALL BufFile (ZArcWork$,WasX) : _
  662.          GOTO 60168
  663.       ZwasB = 1
  664.       LastArc = ZwasQ
  665.       FirstArc = ZwasB
  666.       FOR ArcIndex = FirstArc TO LastArc
  667.            WasZ$ = ZUserIn$(ArcIndex)
  668.             CALL AllCaps (WasZ$)
  669.              IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
  670.             Wildcards = ZTrue                                      'Pe 08/21/91
  671.          CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)
  672. '
  673. Gosub 60190  'Pe 10/03/91
  674. '
  675. If WildCards = ZTrue Then _
  676.    WildCards = ZFalse : _
  677.     Call QuickTput1 (ZCrLf$ +" The following files were extracted..." +ZCrLF$): _ 'Pe 10/03/91
  678.      Extract$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST" : _
  679.    CALL ShellExit (Extract$) : _     'Pe 10/03/91
  680.   CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX) : _
  681. Goto 60171
  682. '                           'Pe 11/03/91
  683.    CALL FindIt(WasZ$)
  684.     IF NOT ZOK THEN _
  685.       CALL QuickTPut1 ("Error extracting " + ZUserIn$(ArcIndex) + "...file Skipped..."+ZCrLF$) : _  'Pe 10/03/91
  686.     GOTO 60171
  687.  CALL QuickTPut1 (ZUserIn$(ArcIndex)+" now  Extracted ..."+ZCrLF$)
  688. '
  689. 60171 NEXT ArcIndex
  690. CALL QuickTPut1 ("Use the C)ompress command to create a "+ZDefaultExtension$ + _
  691.                   " file of Xtracted files"+ZCrLF$)  'Pe 10/03/91
  692.           GOTO 60140
  693. '
  694. '********** ZIP all files in the ZArkViewPath$ into VIEW.ZIP **********
  695. '
  696. 60175 ZSubparm = 1
  697.       CALL QuickTPut1 ("One Moment Compressing file(s)...")  'Pe 10/03/91
  698.       WasX$ = ZDiskForDos$ + "RE" +ZDefaultExtension$ + ".BAT"
  699.       CALL FindIt (WasX$)
  700.        IF NOT ZOK THEN _
  701.         Call QuickTPut1 (CHR$(7)+" Sorry  RE" +_
  702.                           ZDefaultExtension$ + ".BAT Missing") : _
  703.           Call QuickTPut1 (CHR$(7) +"  Please notify Sysop...") : _
  704.          Call DelayTime (3) : _
  705.        EXIT SUB
  706.    CALL QuickTPut1 (" Creating "+ZDefaultExtension$ +_
  707.                                         " file...")  'Pe 10/03/91
  708.    CALL ShellExit (WasX$ + " " + ZArkViewPath$ +_
  709.                    " " + ZDefaultExtension$ + " " + ZNodeId$) 'LK 08/15/91
  710.     Gosub 60182  'Pe 10/18/91
  711.   Goto 60140
  712.  
  713. '
  714. ' **** Check to see if Compresion was successfull if NOT then redo *****
  715. '
  716. 60182 'pe 10/18/91
  717. ViewFileName$ = ZArkViewPath$ + "VIEW" + ZNodeId$ + "." + ZDefaultExtension$ 'LK 08/15/91
  718. CALL FindIt (ViewFileName$)
  719. IF NOT ZOK THEN _
  720. CALL QuickTPut1 ( "No files to Compress...you must use the X)tract command first"+ZCrLF$ ) : _ 'Pe 10/03/91
  721. CALL DelayTime (2) : _
  722. GOTO 60140
  723. CALL QuickTPut1 (ZCrLF$ +" File has been Compressed and named... VIEW"+ZNodeId$+"."+ZDefaultExtension$ +"..."+ZCRLF$) 'LK 08/15/91
  724. Return
  725. '
  726. '
  727. '********** Tells the caller the name of the file to download **********
  728. '
  729. 60183 CALL CheckTimeRemain (MinsRemaining)  'Pe 03/30/92
  730.       IF ZSubParm = -1 THEN _               'Pe 03/30/92
  731.           Exit Sub                          'Pe 03/30/92
  732.  ZFileSysParm = 3   ' Pe 10/20/91
  733.        ZUserIn$ = "D"
  734.         Call FileSystem
  735.       IF ZDnldCompleted = ZTrue AND ZAutoEnd = 1 THEN _
  736.           ZSubParm = -1 : _ 
  737.             Exit Sub                   'AUTO Loggoff Mod
  738. GOTO 60140
  739. '
  740. '******** Subroutine to Extract from Archive..RE???.BAt must exist *****
  741. '
  742. 60190  WasX$ = ZDiskForDos$ + "X" + ZLastExt$ + ".BAT"    'Pe 08/14/91 line num
  743.       CALL FindIt (WasX$)
  744.       IF NOT ZOK THEN _
  745. Call QuickTPut1 (" Sorry Feature not supported for "+ ZLastExt$ +" file(s)") : _
  746. Call DelayTime (3) : _
  747.        EXIT SUB
  748.       CALL ReadDir (2,1)
  749.       IF EOF(2) THEN _
  750.          WasX$ = ZOutTxt$ : _
  751.          ZGSRAra$(1) = ZFileName$ : _
  752.          ZGSRAra$(2) = WasZ$ : _
  753.          ZGSRAra$(3) = ZArkViewPath$
  754.       CALL QuickTPut1 (" Extracting file...")  'PE 10/03/91
  755.       CALL ShellExit (WasX$)
  756.       WasZ$ = ZArkViewPath$ + WasZ$
  757. Return
  758. '
  759. ' Kills files in ViewSubdir to allow better control of VieFiles
  760. '
  761. 60200 ZSubParm = 1
  762.      ZOutTxt$ = "What file(s) to Kill, or [ENTER] to quit" 
  763.      CALL TGet
  764. IF ZSubParm = -1 THEN _
  765.  EXIT SUB
  766.       ZWasB = 1
  767.        IF ZWasQ = 0 THEN _
  768.         GOTO 60140
  769.        LastArc = ZWasQ
  770.        FirstArc =ZWasB
  771. FOR ArcIndex = FirstArc TO LastArc
  772. WasZ$ = ZUserIn$(ArcIndex)
  773.    CALL AllCaps (WasZ$)  
  774.       WasZ$ = ZArkViewPath$ + WasZ$
  775.       CALL KillWork(WasZ$)   'get rid of the files that are NOT wanted
  776.       Call QuickTPut1 (WasZ$ + "  Now Deleted...!" )
  777.        NEXT ArcIndex
  778. Goto 60140
  779. 60280 END SUB
  780. '
  781. '
  782. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  783. '  $PAGE
  784. '
  785. '
  786. ' Error handling for the separately compiled subroutines of RBBS-PC
  787. '
  788. '
  789. * REPLACING old line(s) by new
  790. 65000 IF ZDebug THEN _
  791.          ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  792.               STR$(ERL) + _
  793.               " ERR=" + _
  794.               STR$(ERR) : _
  795.          IF ZPrinter THEN _
  796.             CALL Printit(ZOutTxt$) _
  797.          ELSE CALL LPrnt(ZOutTxt$,1)
  798.       ZErrCode = ERR
  799. '
  800. '     SetCall
  801. '
  802.       IF ERL = 108 THEN _
  803.          CALL PScrn ("Unable to create callers log " + ZCallersFile$) : _
  804.          SYSTEM
  805.       IF ERL = 110 THEN _
  806.           RESUME NEXT
  807. '
  808. '     OPEN CONFIG FILE
  809. '
  810.        IF ERL => 117 AND ERL <= 119 THEN _
  811.           RESUME NEXT
  812. '
  813. * ------[ first line different ]------
  814. '    Create ArkViewSubdir error handling   'Pe 08/15/91
  815.       IF ERL = 150 and ERR = 75 THEN _     'Pe 08/15/91
  816.       ZErrCode = ERR : _
  817.          RESUME NEXT                       'Pe 08/15/91
  818. '
  819. '
  820. '     OPEN COM PORT ERROR HANDLING
  821. '
  822.       IF ERL = 200 THEN _
  823.          CLS : _
  824.          CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  825.          STOP
  826. '
  827. '     GetCom ERROR HANDLING
  828. '
  829.        IF ERL = 1420 AND ERR = 57 THEN _
  830.           RESUME NEXT
  831.        IF ERL = 1420 AND ERR = 69 THEN _
  832.           ZSubParm = -1 :_
  833.           RESUME NEXT
  834. '
  835. '      OPENRESEQ ERROR HANDLING
  836. '
  837.        IF ERL = 1487 THEN _                            ' Pe 08/25/91
  838.            ZErrCode = ERR : _
  839.            RESUME NEXT
  840. '
  841. '      OpenUser ERROR HANDLING
  842. '
  843.        IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
  844.           CALL DelayTime (30) : _
  845.           RESUME
  846. '
  847. '      FindUser ERROR HANDLING
  848. '
  849.        IF ERL = 12610 OR ERL = 12600 THEN _
  850.           RESUME NEXT
  851. '
  852. '     UpdtCalr ERROR HANDLING
  853. '
  854.        IF ERL = 13663 THEN _
  855.           RESUME NEXT
  856.        IF ERL = 13672 AND ERR = 61 THEN _
  857.           CALL QuickTPut1 ("Disk Full") : _
  858.           IF ZDiskFullGoOffline THEN _
  859.              GOTO 65010 _
  860.           ELSE RESUME NEXT
  861.        IF ERL = 13672 THEN _
  862.           ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  863.           RESUME NEXT
  864. '
  865. '     ZPrinter ERROR HANDLING
  866. '
  867.        IF ERL = 13674 THEN _
  868.           ZPrinter = ZFalse : _
  869.           RESUME
  870. '
  871. '     FindIt ERROR HANDLING
  872. '
  873.        IF ERL = 20221 THEN _
  874.           RESUME NEXT
  875.        IF ERL = 20223 AND ZErrCode = 58 THEN _
  876.           ZErrCode = 64 : _
  877.           ZOK = ZFalse : _
  878.           RESUME NEXT
  879.        IF ERL = 20223 AND ZErrCode = 76 THEN _
  880.           CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
  881.           ZErrCode = 76 : _
  882.           ZOK = ZFalse : _
  883.           RESUME NEXT
  884.        IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
  885.           AND ZNetworkType = 6 THEN _
  886.              ZErrCode = 0 : _
  887.              RESUME NEXT
  888.        IF ERL => 20221 AND ERL <= 20223 THEN _
  889.           RESUME
  890. '
  891. '     FlushCom ERROR HANDLING
  892. '
  893.        IF ERL = 20310 AND ERR = 14 THEN _       'Pe 01/03/90
  894.           RESUME NEXT                           'Pe 01/03/90
  895.        IF ERL = 20311 AND ERR = 57 THEN _
  896.           RESUME NEXT
  897.        IF ERL = 20311 AND ERR = 69 THEN _
  898.           ZAbort = ZTrue : _
  899.           ZSubParm = -1 : _
  900.           RESUME NEXT
  901. '
  902. '     NetBIOS ERROR HANDLING
  903. '
  904.        IF ERL => 29900 AND ERL <= 29920 THEN _
  905.           RESUME NEXT
  906. '
  907. '     UpdateC ERROR HANDLING
  908. '
  909.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  910.          ZOutTxt$ = "* Disk full - terminating *" : _
  911.          ZSubParm =2 : _
  912.          CALL TPut : _
  913.          IF ZDiskFullGoOffline THEN _
  914.            GOTO 65010 _
  915.          ELSE SYSTEM
  916. '
  917. '     CheckInt ERROR HANDLING
  918. '
  919.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  920.           ZNotCTS = ZTrue : _
  921.           CALL Line25 : _
  922.           ZErrCode = 0 : _
  923.           RESUME
  924.        IF ERL => 52000 AND ERL <= 59725 THEN _
  925.           RESUME NEXT
  926. '
  927. '     FindFile ERROR HANDLING
  928. '
  929.        IF ERL = 59791 THEN _
  930.           IF ERR = 57 THEN _
  931.              CALL DelayTime (1) : _
  932.              CALL UpdtCalr ("SLOW I/O ERROR",1) : _
  933.              IOErrorCount = IOErrorCount + 1 : _
  934.              IF IOErrorCount < 11 THEN _
  935.                 RESUME
  936. '
  937. '* ------[ first line different ]------
  938.  
  939.       IF ERL = 59800 AND ERR = 70 THEN                               ' CHAT0805
  940.          RESUME NEXT                                                 ' CHAT0805
  941.       END IF                                                         ' CHAT0805
  942. '                                                                    ' CHAT0805
  943.       IF ERL = 59810 AND ERR = 70 THEN                               ' CHAT0805
  944.          RESUME NEXT                                                 ' CHAT0805
  945.       END IF                                                         ' CHAT0805
  946. '
  947. '
  948. '      VIEW ARC TXT ERROR HANDLER
  949. '
  950.  IF ERL => 60140 AND ERR = 53 THEN _                              'Pe 10/20/91
  951.          CALL QuickTPut1 ("ERROR ! No Such File, EXITING"):_
  952.          RESUME NEXT
  953. IF ERL => 60140 AND ERR = 63 THEN _                              'Pe 10/20/91
  954.          CALL QuickTPut1 ("ERROR Occured, Please notify SysOp"):_
  955.          RESUME NEXT
  956. ' Pe 10/20/91
  957. '
  958. '
  959. '     CATCH ALL OTHER ERRORS
  960. '
  961.        ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
  962.             STR$(ERR) + _
  963.             " in line" + _
  964.             STR$(ERL)
  965.        CALL QuickTPut1 (ZOutTxt$)
  966.        CALL UpdtCalr (ZOutTxt$,2)
  967.        RESUME NEXT
  968. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  969.